home *** CD-ROM | disk | FTP | other *** search
/ Complete Linux / Complete Linux.iso / docs / apps / circuits / spice2g6.z / spice2g6 / spice / Fortran / swapij.f < prev    next >
Encoding:
Text File  |  1989-02-03  |  4.4 KB  |  179 lines
  1.       subroutine swapij(i1,i2,j1,j2)
  2.       implicit double precision (a-h,o-z)
  3. c spice version 2g.6  sccsid=tabinf 3/15/83
  4.       common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem,
  5.      1   isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize,
  6.      2   junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr,
  7.      3   nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1,
  8.      4   lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd,
  9.      5   imynl,imvn,lcvn,nsnod,nsmat,nsval,icnod,icmat,icval,
  10.      6   loutpt,lpol,lzer,irswpf,irswpr,icswpf,icswpr,irpt,jcpt,
  11.      7   irowno,jcolno,nttbr,nttar,lvntmp
  12. c spice version 2g.6  sccsid=blank 3/15/83
  13.       common /blank/ value(200000)
  14.       integer nodplc(64)
  15.       complex cvalue(32)
  16.       equivalence (value(1),nodplc(1),cvalue(1))
  17. c
  18. c     swap rows i1 and i2
  19. c
  20.       loc1=nodplc(jcpt+i1)
  21.       loc2=nodplc(jcpt+i2)
  22.       nodplc(jcpt+i1)=loc2
  23.       nodplc(jcpt+i2)=loc1
  24. c
  25. c     check if end of row
  26. c
  27.     5 if (loc1.le.0.and.loc2.le.0) go to 80
  28. c
  29. c     check swap type
  30. c
  31.       if (loc1.eq.0) go to 20
  32.       if (loc2.eq.0) go to 10
  33.       if (nodplc(jcolno+loc1)-nodplc(jcolno+loc2)) 10,15,20
  34.    10 ktype=-1
  35.       j=nodplc(jcolno+loc1)
  36.       go to 25
  37.    15 ktype=0
  38.       j=nodplc(jcolno+loc1)
  39.       go to 25
  40.    20 ktype=1
  41.       j=nodplc(jcolno+loc2)
  42. c
  43. c     find pointer to entry (i1,j)
  44. c
  45.    25 loc=j
  46.    30 lsav1=loc
  47.       loc=nodplc(irpt+loc)
  48.       if (loc.eq.0) go to 40
  49.       if ((nodplc(irowno+loc)-i1).lt.0) go to 30
  50. c
  51. c     find pointer to entry (i2,j)
  52. c
  53.    40 loc=j
  54.    45 lsav2=loc
  55.       loc=nodplc(irpt+loc)
  56.       if (loc.eq.0) go to 55
  57.       if ((nodplc(irowno+loc)-i2).lt.0) go to 45
  58. c
  59. c     branch for col j in row i1, in both row i1 and i2, or in row i2
  60. c
  61.    55 if (ktype) 60,70,75
  62. c
  63. c     entry (i1,j)
  64. c
  65.    60 if (lsav1.eq.lsav2) go to 65
  66.       loc=nodplc(irpt+lsav2)
  67.       nodplc(irpt+lsav2)=loc1
  68.       nodplc(irpt+lsav1)=nodplc(irpt+loc1)
  69.       nodplc(irpt+loc1)=loc
  70.    65 nodplc(irowno+loc1)=i2
  71.       loc1=nodplc(jcpt+loc1)
  72.       go to 5
  73. c
  74. c     entries (i1,j) and (i2,j)
  75. c
  76.    70 nodplc(irpt+lsav1)=loc2
  77.       nodplc(irpt+lsav2)=loc1
  78.       loc=nodplc(irpt+loc1)
  79.       nodplc(irpt+loc1)=nodplc(irpt+loc2)
  80.       nodplc(irpt+loc2)=loc
  81.       nodplc(irowno+loc1)=i2
  82.       nodplc(irowno+loc2)=i1
  83.       loc1=nodplc(jcpt+loc1)
  84.       loc2=nodplc(jcpt+loc2)
  85.       go to 5
  86. c
  87. c     entry (i2,j)
  88. c
  89.    75 if (lsav1.eq.lsav2) go to 78
  90.       loc=nodplc(irpt+lsav1)
  91.       nodplc(irpt+lsav1)=loc2
  92.       nodplc(irpt+lsav2)=nodplc(irpt+loc2)
  93.       nodplc(irpt+loc2)=loc
  94.    78 nodplc(irowno+loc2)=i1
  95.       loc2=nodplc(jcpt+loc2)
  96.       go to 5
  97. c
  98. c     swap columns j1 and j2
  99. c
  100.    80 loc1=nodplc(irpt+j1)
  101.       loc2=nodplc(irpt+j2)
  102.       nodplc(irpt+j1)=loc2
  103.       nodplc(irpt+j2)=loc1
  104. c
  105. c     check for end of column
  106. c
  107.    85 if (loc1.le.0.and.loc2.le.0) go to 160
  108. c
  109. c     check swap type
  110. c
  111.       if (loc1.eq.0) go to 100
  112.       if (loc2.eq.0) go to 90
  113.       if (nodplc(irowno+loc1)-nodplc(irowno+loc2)) 90,95,100
  114.    90 ktype=-1
  115.       i=nodplc(irowno+loc1)
  116.       go to 105
  117.    95 ktype=0
  118.       i=nodplc(irowno+loc1)
  119.       go to 105
  120.   100 ktype=1
  121.       i=nodplc(irowno+loc2)
  122. c
  123. c     find pointer to entry (i,j1)
  124. c
  125.   105 loc=i
  126.   110 lsav1=loc
  127.       loc=nodplc(jcpt+loc)
  128.       if (loc.eq.0) go to 120
  129.       if ((nodplc(jcolno+loc)-j1).lt.0) go to 110
  130. c
  131. c     find pointer to entry (i,j2)
  132. c
  133.   120 loc=i
  134.   125 lsav2=loc
  135.       loc=nodplc(jcpt+loc)
  136.       if(loc.eq.0) go to 135
  137.       if ((nodplc(jcolno+loc)-j2).lt.0) go to 125
  138. c
  139. c     branch for row i in col j1, in both col"s j1 and j2, or in col j2
  140. c
  141.   135 if (ktype) 140,150,155
  142. c
  143. c     entry (i,j1)
  144. c
  145.   140 if (lsav1.eq.lsav2) go to 145
  146.       loc=nodplc(jcpt+lsav2)
  147.       nodplc(jcpt+lsav2)=loc1
  148.       nodplc(jcpt+lsav1)=nodplc(jcpt+loc1)
  149.       nodplc(jcpt+loc1)=loc
  150.   145 nodplc(jcolno+loc1)=j2
  151.       loc1=nodplc(irpt+loc1)
  152.       go to 85
  153. c
  154. c     entries (i1,j) and (i2,j)
  155. c
  156.   150 nodplc(jcpt+lsav1)=loc2
  157.       nodplc(jcpt+lsav2)=loc1
  158.       loc=nodplc(jcpt+loc1)
  159.       nodplc(jcpt+loc1)=nodplc(jcpt+loc2)
  160.       nodplc(jcpt+loc2)=loc
  161.       nodplc(jcolno+loc1)=j2
  162.       nodplc(jcolno+loc2)=j1
  163.       loc1=nodplc(irpt+loc1)
  164.       loc2=nodplc(irpt+loc2)
  165.       go to 85
  166. c
  167. c     entry (i,j2)
  168. c
  169.   155 if (lsav1.eq.lsav2) go to 158
  170.       loc=nodplc(jcpt+lsav1)
  171.       nodplc(jcpt+lsav1)=loc2
  172.       nodplc(jcpt+lsav2)=nodplc(jcpt+loc2)
  173.       nodplc(jcpt+loc2)=loc
  174.   158 nodplc(jcolno+loc2)=j1
  175.       loc2=nodplc(irpt+loc2)
  176.       go to 85
  177.   160 return
  178.       end
  179.